EDUCORP 8/Educorp2Compilation.sit/educorp2/Programming (2300, 7000)/2307 Programming v.5/XLisp/XLISP Examples/Glue10.LSP

Lisp/Scheme | 1985-12-04 | 5.2 KB | 252 lines

;            GLUE.LSP 1.0
;
;    "Glue" functions for the toolbox call supported by XLISP 1.5b.

;
;   This is a rough and very incomplete description of the toolbox
;   facilities available.  Please send corrections and suggestions
;   to me by easyplex on CIS (George Acton 73026,2663), or to David
;   Betz at his board (603-623-1711).
;

;   THE 1.5b GRAPHICS WINDOW
;
;   The current version of XLISP has a number of toolbox calls
;   implemented in a separate graphics window.  The global
;   *graphics-window* holds a pointer to that window for the
;   toolbox calls.  When one of the built-in graphics functions is
;   executed, the graphics output is sent to that window and the
;   current window is reset to the *command-window* on exit.
;

;
;      XLISP GLUE
;

;
;   ClearScreen -- defines screen as rectangle, then erases
;
(defun ClearScreen (&aux screen)
       (setq screen (NewPtr 8))
       (SetRect screen 0 0 512 342)
       (EraseRect screen) )

;
;   simple event manager -- responds to mouse and keyboard
;
(defun event-man ()
       (prog (result *mou*)
             (setq *mou* (NewPtr 4))
             loop
         (setq result (event-loop *mou*))
         (print result)
         (go loop)) )

(defun event-loop (*mou*)
       (prog (ch)
             loop
             (cond ((= (Button) 256)
               (GetMouse *mou*)
               (return (list 'mouse
                          (peek *mou*)
                          (peek (+ 2 *mou*)) )) )
         ((setq ch (read-char-no-hang))
             (return (list 'key ch)) )
         (t (go loop)) ) )  )

;
;       TOOLBOX GLUE  -- keyed to Chernicoff
;

;
;   2.2.1 Single Bit Access
;
(defun BitTst (ptr offset)
       (toolbox-16 #xA85D (LoWord ptr) (HiWord ptr)
                          (LoWord offset) (HiWord offset) ) )

;
;
;   Word Access -- duplicates HiWord and LoWord 2.2.3
;
;    NB HiWord and LoWord are implemented as primitives in XLISP 1.5b.
;
(defun HiBytes (x)
       (/ x 65536))

(defun LoWord (x)
       (rem x 65536))

;
;   4.1.1 Points
;
(defun SetPt (pt hc vc)
       (toolbox #xA880 (LoWord pt) (HiWord pt) hc vc) )

;
;   4.1.2 Rectangles
;
(defun SetRect (rect left top right bottom)
       (toolbox #xA8A7 (LoWord rect) (HiWord rect) left top right bottom))

;
;   4.1.5 Regions
;
(defun NewRgn ()
       (toolbox-32 #xA8D8) )

(defun DisposeRgn (rgn)
       (toolbox #xA8D9 (LoWord rgn) (HiWord rgn)) )

(defun OpenRgn (rgn)
       (toolbox #xA8DA (LoWord rgn) (HiWord rgn)) )

(defun CloseRgn (rgn)
       (toolbox #xA8DB (LoWord rgn) (HiWord rgn)) )

;
;   5.2.2 Setting Pen Characteristics
;
(defun PenSize (h w)
       (toolbox #xA89B h w) )

(defun PenPat (pat)
       (toolbox #xA89D pat) )

(defun PenMode (mode)
       (toolbox #xA89C mode) )

(defun PenNormal ()
       (toolbox #xA89E) )

;
;   5.2.3 Hiding and Showing the Pen
;
(defun HidePen ()
       (toolbox #xA896) )

(defun ShowPen ()
       (toolbox #xA897) )

;
;   5.2.4 Drawing Lines
;
(defun GetPen (pt)
       (toolbox #xA89A (LoWord pt) (HiWord pt)) )

(defun Move (x y)
       (toolbox #xA894 x y))

(defun MoveTo (x y)
       (toolbox #xA893 x y))

(defun Line (x y)
       (toolbox #xA892 x y))

(defun LineTo (x y)
       (toolbox #xA891 x y))

;
;   5.3.2 Drawing Rectangles
;
(defun FrameRect (rect)
       (toolbox #xA8A1 (LoWord rect) (HiWord rect)) )

(defun PaintRect (rect)
       (toolbox #xA8A2 (LoWord rect) (HiWord rect)) )

(defun EraseRect (rect)
       (toolbox #xA8A3 (LoWord rect) (HiWord rect)) )

(defun InvertRect (rect)
       (toolbox #xA8A4 (LoWord rect) (HiWord rect)) )

;
;   5.3.4 Drawing Ovals
;
(defun FrameOval (rect)
       (toolbox #xA8B7 (LoWord rect) (HiWord rect)) )

(defun PaintOval (rect)
       (toolbox #xA8B8 (LoWord rect) (HiWord rect)) )

(defun EraseOval (rect)
       (toolbox #xA8B9 (LoWord rect) (HiWord rect)) )

(defun InvertOval (rect)
       (toolbox #xA8BA (LoWord rect) (HiWord rect)) )


;
;   5.3.7 Drawing Regions
;
(defun FrameRgn (rgn)
       (toolbox #xA8D2 (LoWord rgn) (HiWord rgn)) )

(defun EraseRgn (rgn)
       (toolbox #xA8D4 (LoWord rgn) (HiWord rgn)) )

;
;   8.3.2 Setting Text Characteristics
;
(defun TextFont (x)
       (toolbox #xA887 x))

(defun TextSize (x)
       (toolbox #xA88A x))

(defun TextFace (x)
       (toolbox #xA888 x))

(defun TextMode (x)
       (toolbox #xA889 x))

;
;   8.3.3 Drawing Text
;
(defun DrawChar (x)
       (toolbox #xA883 x))

;
;   Chernikoff -- vol. 2
;

;
;   Event Management
;
;   The XLISP event loop uses the toolbox call GetNextEvent, which clears
;   the event queue.  It is possible to read the mouse and keyboard
;   buffers directly.  Also, the XLISP function (get-char-no-hang) can be
;   used to examine the keyboard.
;

;
;   2.4.1 Reading the Mouse Position
;
(defun GetMouse (pt)
       (toolbox #xA972 (LoWord pt) (HiWord pt)) )

;
;   2.4.2 Reading the Mouse Button
;
(defun Button ()
       (toolbox-16 #xA974) )

;
;   1.6.1 Reading the Keyboard
;
;    keymap: 16 bytes
;    global: $174
;
(defun GetKeys (keymap)
       (toolbox #xA976 (LoWord keymap) (HiWord keymap)) )
;
;   2.8.1 Beeping the Speaker
;
;    NB mistake in Chernikoff.  Arg is ticks, not secs.
;
(defun Sysbeep (n)
       (toolbox #xA9C8 n))